home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / comm / cpt152.zip / CPT-S152.ZIP / CPT-ST.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-16  |  3KB  |  101 lines
  1. PROGRAM Sort_or_Analyze_Conference_Participation_Tracker_Database;
  2. {$M 5120,0,655360}
  3. {$N-,E- no math support needed}
  4. {$X- function calls may not be discarded}
  5. {$I- disable I/O checking (trap errors by checking IOResult)}
  6.  
  7. USES DOS, NUMDAYS, CPT_CODE;
  8.  
  9. {$IFDEF sort}
  10. CONST
  11.   progname='CPT-Sort';
  12.   progdesc = progname+version+'- Free DOS utility: Sort CPT Database.';
  13. {$ENDIF}
  14. {$IFDEF stat}
  15. CONST
  16.   progname='CPT-Stat';
  17.   progdesc = progname+version+'- Free DOS utility: Produce statistics from CPT Database.';
  18. {$ENDIF}
  19.  
  20. VAR SavedExitProc: POINTER;
  21.  
  22. {===========================================================================}
  23.  
  24. PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
  25. BEGIN
  26.   ExitProc := SavedExitProc;
  27.   cursorOn;
  28.   IF (ExitCode > 0) THEN BEGIN
  29.     WriteLn (progdesc);
  30.     WriteLn (author+lf);
  31.     WriteLn ('Usage: '+progname+' <CPT file> <sort order>'+lf);
  32.     WriteLn ('The "sort order" may be any one or more of the following:'+lf);
  33.     WriteLn ('    name     = sort by first name, ascending (A to Z)');
  34.     WriteLn ('   -name     = sort by first name, descending (Z to A)');
  35.     WriteLn ('    sent     = sort by messages sent, ascending (fewest messages at top)');
  36.     WriteLn ('   -sent     = sort by messages sent, descending (most messages at top)');
  37.     WriteLn ('    oldest   = sort by oldest message, ascending (new people at end)');
  38.     WriteLn ('   -oldest   = sort by oldest message, descending (new people at top)');
  39.     WriteLn ('    newest   = sort by newest message, ascending (current posters at end)');
  40.     WriteLn ('   -newest   = sort by newest message, descending (current posters at top)'+lf);
  41.     WriteLn ('Example:  '+progname+' cnf_123.dat -sent');
  42.     WriteLn ('Example:  '+progname+' 45.mem -sent name'+lf);
  43.   END;
  44.   IF ErrorAddr <> NIL THEN {If an unanticipated run-time error occured...}
  45.   BEGIN
  46.     WriteLn ('An unanticipated error occurred, please contact DDA with the following data:');
  47.     WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
  48.     WriteLn ('Code    = ', ExitCode);
  49.     ErrorAddr := NIL; {IMPORTANT!!!}
  50.   END
  51.   ELSE
  52.     IF (ExitCode IN [1..254]) THEN
  53.       WriteError (ExitCode);
  54. END;
  55. {===========================================================================}
  56.  
  57. VAR MemberInfo  : MemLink;
  58.   Members     : WORD;
  59.   MemFileName : PATHSTR;
  60.   PCount      : BYTE;
  61.   DotPos      : BYTE;
  62.  
  63. BEGIN
  64.   SavedExitProc := ExitProc;
  65.   ExitProc := @CustomExit;
  66.  
  67.   IF ParamCount < 2 THEN Halt (255);
  68.  
  69.   MemFileName := GetConfNUMBER (ParamStr (1));
  70.   IF NOT IsFile (MemFileName) THEN Halt (1);
  71.  
  72. {$IFDEF sort}
  73.   WriteLn (progname+' resorting '+MemFileName);
  74. {$ENDIF}
  75. {$IFDEF stat}
  76.   WriteLn (progname+' analyzing '+MemFileName);
  77. {$ENDIF}
  78.  
  79.   Members := BuildList (MemberInfo, MemFileName); WriteLn;
  80.  
  81.   IF MemberInfo <> NIL THEN BEGIN
  82.     FOR PCount := ParamCount DOWNTO 2 DO BEGIN
  83.       GetSortField (ParamStr (Pcount));
  84.       SortLinkedList (MemberInfo); WriteLn;
  85.     END;
  86.  
  87. {$IFDEF sort}
  88.     WriteList (MemberInfo, MemFileName, Members); WriteLn;
  89. {$ENDIF}
  90. {$IFDEF stat}
  91.     DotPos := Pos ('.', MemFileName);
  92.     IF DotPos > 0 THEN
  93.       Delete (MemFileName, DotPos, 1 + Length (MemFileName) - DotPos);
  94.     WriteStats (MemberInfo, MemFileName+ '.STT', Members);
  95.     WriteLn (lf+'Statistics are in: '+MemFileName+'.STT');
  96. {$ENDIF}
  97.  
  98.   END;
  99.   WriteLn ('Mission accomplished!');
  100. END.
  101.